Whiteline: Alpha/Whiteline Alpha.iso/progtool/pascal/o_gem/source/tictacto/tictacto.pas

Pascal/Delphi Source File | 1994-09-22 | 10.7 KB | 422 lines

PROGRAM TICTAC;

{

Kleines TicTacToe (bedarf wohl keiner Erklärung) für PurePascal und
ObjectGEM.

Darf zusammen mit ObjectGEM unverändert weitergegeben werden.


                                        Jan Pilgenröder, 1994
}

USES
    GEM,OTypes,OWindows;

{$I TICTACH.I}

TYPE
    TMyApplication =    OBJECT(TApplication)
                            PROCEDURE InitInstance; VIRTUAL;
                            PROCEDURE InitMainWindow; VIRTUAL;
                        END;

    PMyWindow =    ^TMyWindow;
    TMyWindow =    OBJECT(TWindow)
                    PROCEDURE InitBoard;
                    PROCEDURE ResetBoard;
                    FUNCTION GetStyle : INTEGER; VIRTUAL;
                END;

    PFeldIcon = ^TFeldIcon;
    TFeldIcon = OBJECT(TIcon)
                    status : (empty,cross,circle);
                    Piece : PIcon;
                    PROCEDURE Work; VIRTUAL;
                END;

    PInfo = ^TInfo;
    TInfo = OBJECT(TToolbar)
                PROCEDURE Work; VIRTUAL;
            END;

    PNew =    ^TNew;
    TNew =     OBJECT(TToolbar)
                PROCEDURE Work; VIRTUAL;
            END;

VAR
    MyApplication : TMyApplication;
    MyWindow : PMyWindow;
    Arena : ARRAY[0..2,0..2] OF PFeldIcon;


PROCEDURE do_circles; FORWARD;

PROCEDURE TMyApplication.InitInstance;
BEGIN
    LoadResource('TicTacH.Rsc','');
    INHERITED InitInstance;
END;

PROCEDURE TMyApplication.InitMainWindow;
VAR
    dumwork : GRECT;
BEGIN
    MyWindow := NEW(PMyWindow,Init(NIL,'TicTacToe'));
    WITH MyWindow^ DO
    BEGIN
        LoadToolbar(panel,FALSE);
        NEW(PInfo,Init(MyWindow,panel,b_info,K_Ctrl,Ctrl_I,NIL,FALSE,FALSE,'Gibt die obligatorische Copyrightmeldung aus.'));
        NEW(PNew,Init(MyWindow,panel,b_new,K_Ctrl,Ctrl_N,NIL,FALSE,FALSE,'Beginnt neues Spiel.'));
        dumwork := work;
        dumwork.g_h := 192;
        dumwork.g_w := 192;
        SetWork(dumwork);
        InitBoard;
    END;
END;

FUNCTION TMyWindow.GetStyle : INTEGER;
BEGIN
    GetStyle := NAME OR CLOSER OR MOVER;
END;

PROCEDURE I_WIN;
BEGIN
    Application^.Alert(MyWindow,1,STOP,'HaHaHa|ICH habe GEWONNEN!!!','Schluchz');
    MyWindow^.ResetBoard;
END;

PROCEDURE I_LOOSE;
BEGIN
    Application^.Alert(MyWindow,1,STOP,'Wehe Mir!!!|Ich habe Versagt!!!','HeHeHe');
    MyWindow^.ResetBoard;
    DO_CIRCLES;
END;

PROCEDURE I_TIE;
BEGIN
    Application^.Alert(MyWindow,1,STOP,'Das war ein Unentschieden...','NaJa');
    MyWindow^.ResetBoard;
END;

PROCEDURE TMyWindow.InitBoard;
VAR
    X,Y : INTEGER;
BEGIN
    FOR X := 0 TO 2 DO
        FOR Y := 0 TO 2 DO
        BEGIN
            Arena[X,Y] := NEW(PFeldIcon,Init(MyWindow,icons,ic_empty,x*64,y*64,FALSE,TRUE,'','Hier können Sie ein Kreuz machen.'));
            Arena[X,Y]^.status := empty;
        END;
END;

PROCEDURE TMyWindow.ResetBoard;
VAR
    X,Y : INTEGER;
BEGIN
    FOR X := 0 TO 2 DO
        FOR Y := 0 TO 2 DO
        BEGIN
            Arena[X,Y]^.status := empty;
            Arena[X,Y]^.uncheck;
            IF Arena[X,Y]^.IsHidden = TRUE THEN
            BEGIN
                Arena[X,Y]^.Unhide;
                Arena[X,Y]^.Piece^.Done;
            END;
        END;
END;

PROCEDURE Set_Circle(x,y : INTEGER);
BEGIN
    Arena[x,y]^.Status := circle;
    Arena[x,y]^.Hide(False);
    Arena[x,y]^.Piece := NEW(PIcon,Init(MyWindow,icons,ic_o,x*64,y*64,FALSE,FALSE,'','Das hier ist der Kreis des Computer-Gegners.'));
END;

PROCEDURE do_circles;
VAR
    FINI,Unentschieden : BOOLEAN;
    X,Y : INTEGER;
BEGIN
    Fini := FALSE;
    {---Lebe ich noch?---}
    FOR X := 0 TO 2 DO
        IF (Fini = FALSE) AND (ARENA[X,0]^.Status = cross) AND (Arena[X,1]^.Status = cross) AND (Arena[X,2]^.Status = cross) THEN
        BEGIN
            Fini := TRUE;
            I_LOOSE;
        END;
    FOR Y := 0 TO 2 DO
        IF (Fini = FALSE) AND (ARENA[0,Y]^.Status = cross) AND (Arena[1,Y]^.Status = cross) AND (Arena[2,Y]^.Status = cross) THEN
        BEGIN
            Fini := TRUE;
            I_LOOSE;
        END;
    IF (Fini = FALSE) AND (ARENA[0,0]^.Status = cross) AND (Arena[1,1]^.Status = cross) AND (Arena[2,2]^.Status = cross) THEN
        BEGIN
            Fini := TRUE;
            I_LOOSE;
        END;
    IF (Fini = FALSE) AND (ARENA[0,2]^.Status = cross) AND (Arena[1,1]^.Status = cross) AND (Arena[2,0]^.Status = cross) THEN
        BEGIN
            Fini := TRUE;
            I_LOOSE;
        END;
    {---Oder ist vieleicht unentschieden---}
    Unentschieden := TRUE;
    FOR X := 0 TO 2 DO
        FOR Y := 0 TO 2 DO
            IF Arena[x,y]^.Status = empty THEN
                Unentschieden := FALSE;
    IF Unentschieden = TRUE THEN
    I_TIE;
    {---Angriff---}
    {2 Kreise in einer Spalte?}
    FOR X := 0 TO 2 DO
    BEGIN
        IF (Fini = FALSE) AND (ARENA[X,0]^.Status = circle) AND (Arena[X,1]^.Status = circle) AND (Arena[X,2]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(x,2);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (ARENA[X,0]^.Status = circle) AND (Arena[X,2]^.Status = circle) AND (Arena[X,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(x,1);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (ARENA[X,1]^.Status = circle) AND (Arena[X,2]^.Status = circle) AND (Arena[X,0]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(x,0);
            I_WIN;
        END;
    END;
    {2 Kreise in einer Zeile?}
    FOR Y := 0 TO 2 DO
    BEGIN
        IF (Fini = FALSE) AND (ARENA[0,Y]^.Status = circle) AND (Arena[1,Y]^.Status = circle) AND (Arena[2,Y]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(2,Y);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (ARENA[0,Y]^.Status = circle) AND (Arena[2,Y]^.Status = circle) AND (Arena[1,Y]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,Y);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (ARENA[1,Y]^.Status = circle) AND (Arena[2,Y]^.Status = circle) AND (Arena[0,Y]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(0,Y);
            I_WIN;
        END;
        {2 Kreise von 0,0 nach 2,2?}
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = circle) AND (Arena[2,2]^.Status = circle) AND (Arena[0,0]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(0,0);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = circle) AND (Arena[0,0]^.Status = circle) AND (Arena[2,2]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(2,2);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (Arena[0,0]^.Status = circle) AND (Arena[2,2]^.Status = circle) AND (Arena[1,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,1);
            I_WIN;
        END;
        {2 Kreise von 0,2 nach 2,0?}
        IF (Fini = FALSE) AND (Arena[0,2]^.Status = circle) AND (Arena[1,1]^.Status = circle) AND (Arena[2,0]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(2,0);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (Arena[0,2]^.Status = circle) AND (Arena[2,0]^.Status = circle) AND (Arena[1,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,1);
            I_WIN;
        END;
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = circle) AND (Arena[2,0]^.Status = circle) AND (Arena[0,2]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(0,2);
            I_WIN;
        END;
    END;
    {---Verteidigung---}
    {2 Kreuze in einer Spalte?}
    FOR X := 0 TO 2 DO
    BEGIN
        IF (Fini = FALSE) AND (ARENA[X,0]^.Status = cross) AND (Arena[X,1]^.Status = cross) AND (Arena[X,2]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(x,2);
        END;
        IF (Fini = FALSE) AND (ARENA[X,0]^.Status = cross) AND (Arena[X,2]^.Status = cross) AND (Arena[X,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(x,1);
        END;
        IF (Fini = FALSE) AND (ARENA[X,1]^.Status = cross) AND (Arena[X,2]^.Status = cross) AND (Arena[X,0]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(x,0);
        END;
    END;
    {2 Kreuze in einer Zeile?}
    FOR Y := 0 TO 2 DO
    BEGIN
        IF (Fini = FALSE) AND (ARENA[0,Y]^.Status = cross) AND (Arena[1,Y]^.Status = cross) AND (Arena[2,Y]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(2,Y);
        END;
        IF (Fini = FALSE) AND (ARENA[0,Y]^.Status = cross) AND (Arena[2,Y]^.Status = cross) AND (Arena[1,Y]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,Y);
        END;
        IF (Fini = FALSE) AND (ARENA[1,Y]^.Status = cross) AND (Arena[2,Y]^.Status = cross) AND (Arena[0,Y]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(0,Y);
        END;
    END;
        {2 Kreuze von 0,0 nach 2,2?}
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = cross) AND (Arena[2,2]^.Status = cross) AND (Arena[0,0]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(0,0);
        END;
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = cross) AND (Arena[0,0]^.Status = cross) AND (Arena[2,2]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(2,2);
        END;
        IF (Fini = FALSE) AND (Arena[0,0]^.Status = cross) AND (Arena[2,2]^.Status = cross) AND (Arena[1,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,1);
        END;
        {2 Kreuze von 0,2 nach 2,0?}
        IF (Fini = FALSE) AND (Arena[0,2]^.Status = cross) AND (Arena[1,1]^.Status = cross) AND (Arena[2,0]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(2,0);
        END;
        IF (Fini = FALSE) AND (Arena[0,2]^.Status = cross) AND (Arena[2,0]^.Status = cross) AND (Arena[1,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,1);
        END;
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = cross) AND (Arena[2,0]^.Status = cross) AND (Arena[0,2]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(0,2);
        END;
        {---Noch nichts Konkretes---}
        {Verteidigung gegen:
            x--
            -o-
            --x
        }
        IF (Fini = FALSE) AND (((Arena[0,0]^.Status = cross) AND (Arena[2,2]^.Status = cross))
                            OR ((Arena[0,2]^.status = cross) AND (Arena[2,0]^.Status = cross))) THEN
            IF Arena[0,1]^.Status = empty THEN
            BEGIN
                Fini := TRUE;
                set_circle(0,1);
            END
            ELSE
                IF Arena[1,0]^.Status = empty THEN
                BEGIN
                    Fini := TRUE;
                    set_circle(1,0);
                END
                ELSE
                    IF Arena[2,1]^.Status = empty THEN
                    BEGIN
                        Fini := TRUE;
                        set_circle(2,1);
                    END
                    ELSE
                        IF Arena[1,2]^.Status = empty THEN
                        BEGIN
                            Fini := TRUE;
                            set_circle(1,2);
                        END;
        {--Mitte Besetzen--}
        IF (Fini = FALSE) AND (Arena[1,1]^.Status = empty) THEN
        BEGIN
            Fini := TRUE;
            set_circle(1,1);
        END;
        {--Ecke Besetzen--}
        IF (Fini = FALSE) THEN
            IF (Arena[0,0]^.Status = empty) THEN
            BEGIN
                Fini := TRUE;
                set_circle(0,0);
            END
            ELSE
                IF (Arena[2,2]^.Status = empty) THEN
                BEGIN
                    Fini := TRUE;
                    set_circle(2,2);
                END
                ELSE
                    IF (Arena[2,0]^.Status = empty) THEN
                    BEGIN
                        Fini := TRUE;
                        set_circle(2,0);
                    END
                    ELSE
                        IF (Arena[0,2]^.Status = empty) THEN
                        BEGIN
                            Fini := TRUE;
                            set_circle(0,2);
                        END;
    IF Fini = FALSE THEN I_TIE;
END;

PROCEDURE TFeldIcon.Work;
BEGIN
    Hide(False);
    status := cross;
    Piece := NEW(PIcon,Init(MyWindow,icons,ic_x,xpos,ypos,FALSE,FALSE,'','Das hier ist Ihr Kreuz.'));
    do_circles;
END;

PROCEDURE TInfo.Work;
BEGIN
    IF ADialog = NIL THEN
        NEW(ADialog,Init(NIL,'Über TicTacToe',info));
    IF ADialog <> NIL THEN
        ADialog^.MakeWindow;
END;

PROCEDURE TNew.Work;
BEGIN
    MyWindow^.ResetBoard;
END;

BEGIN
    MyApplication.Init('TTT1','TicTacToe');
    MyApplication.Run;
    MyApplication.Done;
END.